(FILECREATED "20-MAY-76 13:26:47" <LENAT>RECORD.;1 2197   

     changes to:  RECORD-BP SETB RECORDCOMS)


  (LISPXPRINT (QUOTE RECORDCOMS)
	      T T)
  [RPAQQ RECORDCOMS ((FNS BPFS RECORD-BP DEFB SETB)
	  TRIVB
	  (P (MOVD SETB SLOW-SETB)
	     (MAPC CONCEPTS (QUOTE DEFB))
	     (ADVISE (QUOTE GETP)
		     (QUOTE (AND (FMEMB ATM CONCEPTS)
				 (PUT PROP ATM (ADD1 (COND [(CAR (FMEMB ATM (CDR PROP]
							   (0]
(DEFINEQ

(BPFS
  [LAMBDA (B)
    (CDDAR (CDDDR (GETD B])

(RECORD-BP
  [LAMBDA (P B)
    [SETQ B (CAR (SEARCHPDL (QUOTE IS-CON]
    (PUT P B (ADD1 (COND
		     ((GETP P B))
		     (0])

(DEFB
  [LAMBDA (B BFL)
    [SETQ BFL (EQ B (CAR (UNBREAK0 B]
    (PUTD B (COPY TRIVB))
    [MAPC XS-PARTS (FUNCTION (LAMBDA (XP BP)
	      (COND
		((GETB B XP)
		  (SETQ BP (GLUEE B XP))
		  (ATTACH (LIST XP (CONS BP (GETARGS XP)))
			  (BPFS B))
		  (PUTD BP (LIST (QUOTE LAMBDA)
				 (GETARGS XP)
				 (LIST (QUOTE SELF-COMPILE)
				       BP
				       (CONS (GETFNAME XP)
					     (FGETB B XP]
    [COND
      ((EQ (GETB B (QUOTE INV))
	   T)

          (* Notice that a Being can now have two clauses (INV ...), but in that case the first will 
	  (properly) point to the ALGS e-part)


	(ATTACH [LIST (QUOTE INV)
		      (CONS (GLUEE B (QUOTE ALGS))
			    (GETARGS (QUOTE ALGS]
		(BPFS B]
    (COND
      (BFL (CPRIN1 1 CRLF CRLF "The Being " B " was broken. Defb" CRLF 
		   " unbroke it, redefined it, and then broke it (BREAK)" DCR)
	   (APPLY* (QUOTE BREAK)
		   B))
      (B])

(SETB
  [LAMBDA (B P Q BP)
    [AND (FMEMB P XEQ-PARTS)
	 Q
	 [PUTD (SETQ BP (GLUEE B P))
	       (LIST (QUOTE LAMBDA)
		     (GETARGS P)
		     (LIST (QUOTE SELF-COMPILE)
			   BP
			   (CONS (GETFNAME P)
				 Q]
	 (OR (GETB B P)
	     (ATTACH (LIST P (CONS BP (GETARGS P)))
		     (BPFS B]
    (PUT B P Q])
)
  (RPAQQ TRIVB [LAMBDA (BP BA1 BA2 BA3 BA4)
		       (RECORD-BP BP)
		       (SELECTQ BP NIL])
  (MOVD SETB SLOW-SETB)
  (MAPC CONCEPTS (QUOTE DEFB))
  [ADVISE (QUOTE GETP)
	  (QUOTE (AND (FMEMB ATM CONCEPTS)
		      (PUT PROP ATM (ADD1 (COND [(CAR (FMEMB ATM (CDR PROP]
						(0]
(DECLARE: DONTCOPY
  (FILEMAP (NIL (431 1883 (BPFS 443 . 492) (RECORD-BP 496 . 627) (DEFB 631 . 1554) (SETB 1558 . 1880)))))
STOP